\ Lesson 1. ABACUS
comment:
This is a demostration on how to build an application
with a simple
graphic user interface completely in the text
mode. The goal is
to use the PC to emulate a calculator with
trancendental functions.
On the screen there are areas to display numbers, and
buttons to
select functions to execute. With Forth running, you can program
this calculator in many different and interesting
ways.
Type ABACUS under DOS and the batch file will load a
calculator program into F-PC. You can use the arrow keys to
select a floating point function. Pressing INS key executes
the selected function. In teh meantime, you have a
command
window so you can enter F-PC commands.
The batch file ABACUS.BAT contains only one line of
commands:
f
abacus ok calc
The Forth file ABACUS.SEQ contains the loading
commands under
FPC:
cr
.( Loading the floating point software, please wait..)
needs sfloat
cr
.( Loading the Abacus Calculator..)
fload abacus1
fload abacus2
Under F-PC, type FLOAD ABACUS to load the
calculator. SFLOAT
package by Bob Smith is required to provide floating
point
functions.
ABACUS1.SEQ contains words to manage the screen, and
ABACUS2.SEQ contains words to implement the floating
point
operations.
These two files are combined in this lesson so
you only have to load this lesson to try out the
calculator.
comment;
needs sfloat \ load Robert Smith's
software floating point package.
comment:
Exercise 1. Some elementary
functions of the calculator
\ BEADS
Define FPC-Calculator Display, 9-22-88, C. H. Ting
comment;
CODE SCROLL-UP
( left upper right lower --- )
\ scroll window up one line
pop
cx
pop
dx \
dl = right column
mov
dh, cl
\ dh = lower row
pop
ax
pop
cx
\ cl = left column
mov
ch, al
\ ch = upper row
mov
bh, attrib
\ filler attribute
mov ax, #
$0601
\ 06 = scroll, 01 = one line
int
$10
next end-code
: frame
dark
0 0
.box" F-PC ABACUS, V1.0 by C. H. Ting"
40 0
75 14 box
0 16
79 23 box
42 1
at
." Floating Point Number Stack"
6 17
at ." Abacus Beads:"
0 3
at ." FPC Commands:"
0 24
at
." Arrows: Select Bead INS: Execute Bead"
45
24 at ." Other Keys: FPC Commands"
0 4
at
;
: .FS
( F: -- )
?FSTACK
FDEPTHB 4 over
\ Display row#
IF
over 1+ DUP 43 - 6 MAX
DO
45 over at FSP0 I - F@ E.
1+
6 +LOOP
then 8 rot 6 / -
0
max 0 ?do
45 over at 20 spaces
1+
loop drop
;
: fsquare fdup f* ;
: fdeg
180.0 f* pi f/ ;
: frad
180.0 f/ pi f* ;
: CLRSCR frame .fs ;
: fe1.0
f1.0 fexp ;
defer quitting
: function-table
exec:
f+
fmax fdup fsin fasin fsinh fasinh fexp flog quitting
f-
fmin fswap fcos facos fcosh facosh f** fln noop
f*
fabs fover ftan fatan ftanh fatanh noop falog noop
f/
fnegate frot noop noop noop noop noop fln2 clrscr
fsquare fsqrt fdrop pi fdeg frad noop noop fe1.0 fclear
;
: ff
dup 0 49 within if function-table else drop then ;
create keypad-table
,"
+ MAX DUP SIN ASIN SINH ASINH EXP LOG QUIT "
," -
MIN SWAP COS ACOS COSH ACOSH ** LN
"
," *
ABS OVER TAN ATAN TANH ATANH ALOG
"
," /
NEG ROT
LN2 CLRSCR"
," **2 SQRT DROP PI
DEG RAD
E CLEAR
"
comment:
Exercise 2. The calculator display
\ FDISPLAY Display for FPC
Calculator, 9-12-88 C. H. Ting
This program generates a Status Display of the
calculator
screen and allows the user to select one floating
point function
by arrow keys for execution.
Total number of functions is specified in variable
MAX-FUNCTIONS.
The status display window shows the status of 50
functions. The
selection function is displayed in reverse
video. Pressing <enter>
executes the function.
comment;
50 constant MAX-FUNCTIONS
0 value current-key
: >display ( Position cursor to the current keypad
in display )
current-key
10 /mod
18 + swap 7 * 6
+
swap at
;
: >table ( -- addr len , obtain text on keypad)
current-key 10
/mod
61 * swap 6 * +
keypad-table 1+
+
6 ;
: reverse-current-key
\ high light current key
>display
>rev
>table type
>norm
\ in reverse video
;
: show-keys
\ Display current page
current-key
\ Save current key
max-functions 0
do
i
=: current-key
>display
>table type
loop
=:
current-key
\ restore current key
reverse-current-key
;
: first-key
off> current-key
;
: last-key
max-functions
1-
=:
current-key
;
: cursor-up
current-key 10 /mod
1- 0
max
10 *
+ =: current-key
;
: cursor-down
current-key 10 /mod
1+ 4
min
10 *
+ =: current-key
;
: current-top
\ move to top of current page
current-key 10 mod
=:
current-key
;
: cursor-left
current-key 10 /mod
swap
1- 0 max
swap
10 * + =: current-key
;
: cursor-right
current-key 10 /mod
swap
1+ 9 min
swap
10 * + =: current-key
;
: first-column
\ move to left of current page
current-key 10 /
10 *
=: current-key
;
: last-column
\ move to right of current page
current-key 10 /
10 *
9 + =: current-key
;
: select ( -- )
current-key function-table
.fs
;
comment:
Exercise 3. Tie everthing together
comment;
hidden also
: fpc
\ restore key/emit for normal Forth operations
[']
crlf is cr
[']
mackey is key
[']
xexpect is expect
staton nofloating
doubles
dark
true abort" Back to FPC"
;
' fpc is quitting
previous forth
: do-cursor ( n -- ) \ assign functions to cursor
keys
ibm-at? rot
\ save cursor
CASE
210 OF select
ENDOF
187 OF abort" back" ENDOF
199 OF first-key ENDOF
200 OF cursor-up ENDOF
203 OF cursor-left ENDOF
205 OF cursor-right ENDOF
207 OF last-key ENDOF
208 OF cursor-down ENDOF
243 OF first-column ENDOF
244 OF last-column ENDOF
245 OF last-key ENDOF
247 OF first-key ENDOF
DROP
ENDCASE
show-keys
at
\ restore cursor
;
: abacus-cr
\ manage the floating point number stack
\ and the little Forth window
#out
@ #line @ 2>r
.fs
2r> at
13
emit 10 emit #out off #line @
13
> if
0 4 39 14 scroll-up
14 #line !
0 14 at
else
#line incr
then
;
: abacus-key
\ new KEY to operate the calculator
begin
defers key dup 127 >
if
do-cursor
else 255 and
exit
then
again
;
: calc
['] abacus-cr is cr \ enter the calculator
mode
[']
abacus-key is key
[']
(expect) is expect
statoff dark frame show-keys
floats floating
;
\s tests
: tt
frame show-keys
begin key dup do-cursor ascii q = until ;